home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue36 / construc / MAILBOB.DPR < prev    next >
Encoding:
Text File  |  1998-06-30  |  4.3 KB  |  146 lines
  1. program MailBob;
  2. {$R MAILBOB.DFM}
  3. {$I-,O+}
  4. uses
  5.   Forms, Extctrls, SysUtils, Classes, DrBobPop, DrBobEml;
  6.  
  7. type
  8.   TMailBox = class(TForm)
  9.     Timer: TTimer;
  10.     procedure FormCreate(Sender: TObject);
  11.     procedure FormDestroy(Sender: TObject);
  12.     procedure TimerTimer(Sender: TObject);
  13.   private
  14.     From,MailTo,Subject,Date: ShortString;
  15.     Lines: TStringList;
  16.     f: Text;
  17.   end;
  18.  
  19.   procedure TMailBox.FormCreate;
  20.   begin
  21.     ChDir('..');
  22.     ChDir('RobotBob');
  23.     System.Assign(output,'mailbob.html');
  24.     Reset(output);
  25.     if IOResult = 0 then Append(output)
  26.                     else Rewrite(output);
  27.     writeln('<HTML>');
  28.     writeln('<BODY BACKGROUND="/gif/back.gif">');
  29.     writeln('<HEAD>');
  30.     writeln('<TITLE>RobotBob/Mail</TITLE>');
  31.     writeln('</HEAD>');
  32.     writeln('<FONT FACE="Comic Sans MS"COLOR=000077>');
  33.     writeln('<H1>RobotBob/Mail v1.0</H1>');
  34.     writeln('</FONT>');
  35.     writeln('<PRE>');
  36.     writeln('MailBob initiated at: ',DateTimeToStr(Now));
  37.     System.Close(output);
  38.     Timer.Enabled := True
  39.   end {FormCreate};
  40.  
  41.   procedure TMailBox.FormDestroy;
  42.   begin
  43.     System.Assign(output,'mailbob.html');
  44.     Append(output);
  45.     writeln;
  46.     writeln('MailBob closing down: ',DateTimeToStr(Now));
  47.     writeln('</BODY>');
  48.     writeln('</HTML>');
  49.     System.Close(output)
  50.   end {FormDestroy};
  51.  
  52.   procedure TMailBox.TimerTimer;
  53.   var
  54.     i,j,k: Integer;
  55.   begin
  56.     System.Assign(output,'mailbob.html');
  57.     Append(output);
  58.     writeln;
  59.     writeln('MailBob waking up at: ',DateTimeToStr(Now));
  60.     try
  61.       with TBPOP3.Create(nil) do
  62.       try
  63.         MailServer := 'pop3.server.com';
  64.         User := 'drbob';
  65.         Password := '********';
  66.         ReadMail;
  67.         writeln(Messages:2,' messages waiting...');
  68.         Lines := TStringList.Create;
  69.         for i:=0 to Pred(Messages) do
  70.         begin
  71.           System.Assign(f,'mailbox');
  72.           Rewrite(f);
  73.           writeln(f,Message[i]);
  74.           System.Close(f);
  75.           Lines.LoadFromFile('mailbox');
  76.           k := 0;
  77.           while (k < Lines.Count) and (Lines[k] <> '') do Inc(k);
  78.           for j:=Pred(k) downto 0 do
  79.           begin
  80.             if (Pos('From: ',Lines[j]) <> 1) and
  81.                (Pos('To: ',Lines[j]) <> 1) and
  82.                (Pos('Subject: ',Lines[j]) <> 1) and
  83.                (Pos('Date: ',Lines[j]) <> 1) then Lines.Delete(j)
  84.             else
  85.             begin
  86.               if Pos('From: ',Lines[j]) = 1 then
  87.                 From := Copy(Lines[j],7,255)
  88.               else
  89.               if Pos('To: ',Lines[j]) = 1 then
  90.                 MailTo := Copy(Lines[j],4,255)
  91.               else
  92.               if Pos('Subject: ',Lines[j]) = 1 then
  93.                 Subject := Copy(Lines[j],10,255)
  94.               else
  95.                 Date := Copy(Lines[j],6,255)
  96.             end
  97.           end {headers};
  98.           if Pos('robotbob@drbob42.com',LowerCase(MailTo)) > 0 then
  99.           begin
  100.             with TBSMTP.Create(nil) do
  101.             try
  102.               MailServer := 'smtp.server.com';
  103.               MessageFrom := 'RobotBob';
  104.               MessageTo := 'drbob@drbob.demon.nl';
  105.               MessageSubject := Subject;
  106.               MessageText.Add('Forwarded messages from '+From);
  107.               MessageText.Add('');
  108.               k := 0;
  109.               while (k < Lines.Count) and (Lines[k] <> '') do Inc(k);
  110.               writeln;
  111.               k := 0;
  112.               while (k < Lines.Count) and (Lines[k] <> '') do Inc(k);
  113.               for j:=0 to Pred(k) do writeln(Lines[j]);
  114.               for j:=k to Pred(Lines.Count) do MessageText.Add(Lines[j]);
  115.               MessageText.Add('');
  116.               MessageText.Add('Groetjes,');
  117.               MessageText.Add('           RobotBob - RobotBob@drbob42.com');
  118.               SendMail;
  119.               write('forwarded to ',MessageTo);
  120.             finally
  121.               Free
  122.             end;
  123.             DeleteMessage(i+1);
  124.             writeln(' and deleted from mailhost')
  125.           end
  126.         end
  127.       finally
  128.         Free
  129.       end;
  130.     except
  131.       on E: Exception do
  132.         writeln('<B>Error:</B> ',E.Message)
  133.     end;
  134.     System.Close(output)
  135.   end;
  136.  
  137. var
  138.   MailBox: TMailBox;
  139.  
  140. begin
  141.   Application.Initialize;
  142.   Application.ShowMainForm := False;
  143.   Application.CreateForm(TMailBox, MailBox);
  144.   Application.Run
  145. end.
  146.